home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / gfx / conv / wiconvert.lha / Wiconvert.ASC < prev    next >
Text File  |  1993-01-21  |  5KB  |  202 lines
  1. '  Windows .ICO to .IFF converter
  2. '  by Jay Gramlich 
  3. '  Jan 20, 1993
  4. '
  5. '  Handles up to 32 color icons
  6. '
  7. '
  8. ' procedure to take two ascii characters, flip them, and get 
  9. ' a value for this 
  10. '
  11. CMD$=Command Line$
  12. Procedure IBMBYT[BYT$]
  13.    X=Val(Hex$(Asc(BYT$)))
  14. End Proc[X]
  15. Procedure IBMHEX[BYT$]
  16.    X$=""
  17.    X$=Hex$(Asc(Left$(BYT$,1)))
  18.    X$=Mid$(X$,2)
  19.    If Len(X$)<2 Then X$="0"+X$
  20.    X$=Hex$(Asc(Mid$(BYT$,2,1)))+X$
  21.    X=Val(X$)
  22. End Proc[X]
  23. Procedure LHEX[BYT$]
  24.    X$=""
  25.    B1$=Left$(BYT$,2)
  26.    B2$=Mid$(BYT$,3,2)
  27.    IBMHEX[B1$]
  28.    X$=Hex$(Param)
  29. 'remove $
  30.    X$=Mid$(X$,2)
  31.    While Len(X$)<4
  32.       X$="0"+X$
  33.    Wend 
  34.    IBMHEX[B2$]
  35.    X$=Hex$(Param)+X$
  36.    X=Val(X$)
  37. End Proc[X]
  38. '
  39. '
  40. Amos To Back 
  41. 'open output window
  42. '
  43. Set Input 10,-1
  44. Open Port 2,"con://560/100/Wiconvert/simple"
  45. Print #2,Chr$(27);"[1mWiconvert 0.10";Chr$(27);"[22m";" by Jay Gramlich ";
  46. Print #2,"1993 Freeware"
  47. Print #2,"This program was written using ";Chr$(27);"[1m";
  48. Print #2,Chr$(27);"[33mAMOS";Chr$(27);"[32";Chr$(27);"[22m"
  49. Print #2,""
  50. '
  51. ' check for ok to do work
  52. '
  53. OK=1
  54. If CMD$="?" or Len(CMD$)=0
  55.    Print #2,"Converts the first icon from a Windows icon file to an iff bitmap"
  56.    Print #2,"Usage: Winconvert ICOfile"
  57.    Print #2,""
  58.    Print #2,"Press 'Return' to end"
  59.    Line Input #2,X$
  60.    OK=0
  61. End If 
  62. If OK=1
  63.    If Exist(CMD$)=0
  64.       Print #2,CMD$;" - File not found"
  65.       Print #2,""
  66.       Print #2,"Press 'return'"
  67.       Line Input #2,X$
  68.       OK=0
  69.    End If 
  70. End If 
  71. '
  72. '
  73. '
  74. If OK
  75.    Open In 1,CMD$
  76. '
  77. ' Get the idReserved and idType bytes always 0 and 1 and start on first
  78. ' directory entry
  79. '
  80.    IDRES$=Input$(1,2)
  81.    IDTYP$=Input$(1,2)
  82.    IBMHEX[IDRESS$]
  83.    IDRES=Param
  84.    IBMHEX[IDTYP$]
  85.    IDTYP=Param
  86.    COUNT$=Input$(1,2)
  87.    COUNT=Param
  88.    JUNK$=Input$(1,2)
  89.    CLRS$=Input$(1,1)
  90.    IBMBYT[CLRS$]
  91.    CLRS=Param
  92.    OK2=1
  93.    If IDRES<>0 or IDTYP<>1 or COUNT<1
  94.       OK2=0
  95.       Print #2,"This doesn't appear to be a correct .ICO file"
  96.       Print #2,""
  97.       Print #2,"Press 'Return'"
  98.       Line Input #2,X$
  99.    End If 
  100.    If CLRS>32
  101.       OK2=0
  102.       Print #2,"Contains ";CLRS;" colors - this program will only supprts 32"
  103.       Print #2,""
  104.       Print #2,"Press 'Return'"
  105.       Line Input #2,X$
  106.    End If 
  107.    If OK2
  108.       Print #2,"There ";
  109.       If COUNT>1
  110.          Print #2,"are ";COUNT;" images. I'll convert the first one"
  111.       Else 
  112.          Print #2,"is 1 image.";
  113.       End If 
  114. '
  115. ' more of first image directory entry - skip alot as info is elsewhere 
  116. '
  117.       JUNK$=Input$(1,9)
  118.       OFFSET$=Input$(1,4)
  119. ' we are now at byte 22 - Let's go to offset for first image 
  120.       LHEX[OFFSET$]
  121.       OFFSET=Param
  122.       Pof(1)=OFFSET
  123. '  bitmapinfo header 
  124.       JUNK$=Input$(1,4)
  125.       WID$=Input$(1,4)
  126.       LHEX[WID$]
  127.       WID=Param
  128.       HEI$=Input$(1,4)
  129.       LHEX[HEI$]
  130.       HEI=Param/2
  131.       JUNK$=Input$(1,2)
  132.       PLN$=Input$(1,2)
  133.       LHEX[PLN$]
  134.       PLN=Param
  135.       JUNK$=Input$(1,24)
  136. '
  137. 'open screen 
  138. '
  139.       Screen Open 0,320,200,2^PLN,Lowres
  140.       Flash Off 
  141.       Curs Off 
  142. '
  143. 'now at RGB color table - set colors 
  144. '
  145.       Print #2,""
  146.       Print #2,"Color Table";
  147.       For X=1 To CLRS
  148.          X$=Input$(1,1)
  149.          IBMBYT[X$]
  150.          B=Param/17
  151.          X$=Input$(1,1)
  152.          IBMBYT[X$]
  153.          G=Param/17
  154.          X$=Input$(1,1)
  155.          R=Param/17
  156.          CL$=Hex$(R)
  157.          CL$=CL$+Mid$(Hex$(G),2,1)
  158.          CL$=CL$+Mid$(Hex$(B),2,1)
  159.          X$=Input$(1,1)
  160.          ' unused byte
  161.          Colour X-1,Val(CL$)
  162.          Print #2,".";
  163.       Next X
  164.          Print #2,""
  165. ' xor mask - read it into a string (will crash if over 65535 in length)
  166.       LG=(WID*HEI*PLN)/8
  167.       BITS$=Input$(1,LG)
  168. '
  169. ' plot xor mask (since just setting color this is all we need to do) 
  170. ' another bug is that this will only work up to 8 bitplanes
  171.       Print #2,"Converting";
  172.       CBIT$=""
  173.       For YC=WID-1 To 0 Step -1
  174.          For XC=0 To HEI-1
  175.             If Len(CBIT$)<PLN
  176.                TBT$=""
  177.                TBT$=Mid$(Bin$(Asc(Left$(BITS$,1))),2)
  178.                BITS$=Mid$(BITS$,2)
  179.                While Len(TBT$)<8
  180.                   TBT$="0"+TBT$
  181.                Wend 
  182.                CBIT$=CBIT$+TBT$
  183.             End If 
  184.             PLTCLR=Val("%"+Left$(CBIT$,PLN))
  185.             CBIT$=Mid$(CBIT$,PLN+1)
  186.             Plot XC,YC,PLTCLR
  187.          Next XC
  188.          If YC mod 2=0
  189.             Print #2,".";
  190.          End If 
  191.       Next YC
  192.       Close 1
  193.       Print #2,""
  194.       Print #2,"Saving to Ram:ICO.IFF"
  195.       Save Iff "ram:ICO.IFF"
  196.       Print #2,""
  197.       Print #2,"Done - Press Return";
  198.       Line Input #2,X$
  199.       Close 2
  200.    End If 
  201. End If 
  202.